home *** CD-ROM | disk | FTP | other *** search
/ CD ROM Paradise Collection 4 / CD ROM Paradise Collection 4 1995 Nov.iso / program / swags_z.zip / STRINGS.SWG / 0012_ST-CASE6.PAS.pas < prev    next >
Pascal/Delphi Source File  |  1993-05-28  |  2KB  |  72 lines

  1. {
  2. NORBERT IGL
  3.  
  4. > Note that your uppercase characters do not include the german Umlauts
  5. > and overlap sometimes with other foreign characters. There is a DOS
  6. > function call to convert a string to all upcercase letters. Norbert
  7. > Igl and I wrote a ASM end implementation, maybe he could repost his all-
  8. > Pascal version that conforms to the DOS country information.
  9.  
  10. }
  11.  
  12. Unit Upper;
  13. { Country-independent upcase-procedures          (c) 1992  N.Igl
  14.  
  15.   Uses the COUNRY=??? from your CONFIG.SYS to get the correct uppercase.
  16.   SpeedUp with a table-driven version to avoid multiple DOS-Calls.
  17.  
  18.   Released to the public domain ( FIDO: PASCAL int'l ) in 12/92 }
  19.  
  20.  
  21. Interface
  22.  
  23. function UpCase(ch : char) : Char;
  24. function UpCaseStr(S : String) : String;
  25.  
  26. Implementation uses Dos;
  27.  
  28. Const
  29.   isTableOk : Boolean = FALSE;
  30. Var
  31.   theTable  : Array[0..255] of Char;
  32.  
  33. Procedure SetUpTable;                          { called only at Unit-init }
  34. var
  35.   Regs: Registers;
  36.   x   : byte;
  37. begin
  38.   FillChar(theTable, Sizeof( theTable ), #0);  { Fill with NULL }
  39.   For x := 1 to 255 do
  40.     theTable[x] := CHAR(x);                    { predefined values }
  41.   if Lo(DosVersion) < 4 then                   { n/a in this DOS... }
  42.   begin                                        { use Turbo's Upcase }
  43.     for x := 1 to 255 do
  44.       theTable[x] := System.Upcase(CHAR(x));
  45.     exit;
  46.   end;
  47.   Regs.AX := $6521;                            { "Capitalize String" }
  48.   Regs.CX := 255;                              { "string"-length }
  49.   Regs.DS := Seg(theTable);                    { DS:DX... }
  50.   Regs.DX := Ofs(theTable[1]);                 {  ...points to the "string"}
  51.   Intr($21,Regs);                              { let DOS do it ! }
  52.   isTableOK := (Regs.Flags and FCarry = 0);    { OK ? }
  53. end;
  54.  
  55. function UpCase(ch : char) : char;
  56. begin
  57.   UpCase := theTable[BYTE(ch)]
  58. end;
  59.  
  60. function UpCaseStr(S : String) : String;
  61. var x: Byte;
  62. begin
  63.   for x := 1 to length(S) do
  64.     S[x]:= theTable[BYTE(S[x])];
  65.   UpCaseStr := S
  66. end;
  67.  
  68. begin
  69.   SetUpTable
  70. end.
  71.  
  72.